home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / UT_SYSTM / 2PENT.ZIP / PENTIUM.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-12-07  |  22.6 KB  |  776 lines
  1. '*******************************PENTIUM.BAS*****************************
  2. 'Hi:
  3. '
  4. 'Trying to understand what all the hoopla in the new papers and on
  5. 'Internet is over discovering that the Pentium chip.... like all CPUs...
  6. 'makes a "floating point" math error.
  7. '
  8. 'If you do long division math (using numbers with decimal places)
  9. 'with a computers, you "always" get some "rounding errors."
  10. 'I think that is true for all computers, not sure but think so.
  11. '
  12. 'Apparently the Internet community is up in arms because they don't know,
  13. 'that. Or... else, everyone on the facility of State U just wants Intel
  14. 'to buy them a new computer!
  15. '
  16. 'The formula given in the New York Times November 24th, 1994
  17. 'was:
  18. '       4,195,835 -[(4,195,835/3,145,727)*3,145,727] = Answer
  19. '
  20. 'The "Answer" is Zero, but with this formula and a Pentium chip, the
  21. 'answer is "256" or an error of 256/4,195,835 or 61/100,000.
  22. '
  23. 'A teeny tiny error unless you are looking to set a new world's record
  24. 'in "prime numbers" as the math person in New York was trying to do when
  25. 'he discovered this little Pentium chip crack.
  26. '
  27. 'You get a zero (0); because that formula divides the first number by a
  28. 'second number to get a fraction (a long division or floating point number)
  29. 'then multiplies that result by the second number.
  30. '
  31. 'It should be very clear to anyone but the hopelessly lost on Internet
  32. 'that a number divided by a second number and then multiplied by that second
  33. 'number is always (always!!!) zero.
  34.  
  35. 'But with computers that last statement just ain't necessarily so....
  36. '
  37. '
  38. 'So.... I have taken it upon myself to give you a little program that
  39. 'will show you that your very own beloved computer of whatever make
  40. 'and kind will do just what the Intel Pentium chip does.... give
  41. 'you long division errors.
  42.  
  43. 'If you have a Pentium computer and a less prestigious one, run this test
  44. 'on both of them. Get back to me if you find big differences in the amount
  45. 'of errors.
  46. '
  47. 'This program is compiled into a stand-alone *.EXE file and as PENTIUM.BAS.
  48. 'PENTIUM.BAS can be transmitted via ASCII type E-Mail to Internet so that
  49. 'those non-mathematical, non-computer types on Internet can
  50. 'run it and -maybe- add some light to the flaming and heat there.
  51. '
  52. 'Use the batch file RUN.BAT as it will start your QBASIC.EXE program
  53. '(comes with DOS 5 and newer) and runs this program.
  54. '
  55. 'Get back to me.... I'm really curious to find out if the Pentium is
  56. 'really worser than the 286, 386, 486 CPUs.
  57. '
  58. 'To run this program with QBASIC.EXE, just open it in that program
  59. 'and "RUN" it or use RUN.BAT which came with this file set.
  60. '
  61. 'John De Palma on CompuServe 76076,571
  62. '
  63. 'Wed  12-07-1994  02:10:17
  64. '===================================================================
  65.  
  66. DEFINT A-Z
  67. CONST True = -1, False = 0
  68.  
  69. DECLARE SUB LapsedTimer (TimerRow%, TimerCol%, Colr%)
  70. DECLARE SUB Splash1 ()
  71. DECLARE SUB PressAnyKey ()
  72. DECLARE SUB IsCursor (IfTrue%)
  73. DECLARE SUB TextInput (text$, MaxLen%)
  74. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  75. DECLARE FUNCTION Rounded# (number#, Places%)
  76. DECLARE SUB RunRan (Samples&)
  77. DECLARE SUB LocateIt (Row%, text$)
  78. DECLARE SUB Splash2 (Choice%)
  79. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  80. DECLARE FUNCTION Center% (text$)
  81. DECLARE FUNCTION YesNo2% (Answer$)
  82. REDIM SHARED Box$(1 TO 56)
  83. BaseRow% = 2
  84. Q$ = CHR$(34)
  85. IsCursor (False)
  86. COLOR 15, 1
  87. CLS
  88. CALL Splash1
  89. SLEEP 8
  90. CALL PressAnyKey
  91. Again:
  92. ReStart% = True
  93. COLOR 15, 1
  94. CLS
  95. CALL Splash2(10)
  96. 'TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  97. Message$ = "Long Division or " + Q$ + "PENTIUM" + Q$ + " Test"
  98. Row% = BaseRow%: Col% = 0: Outline% = 5: Shadow% = True: Length% = False
  99. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  100.  
  101.  
  102. text$ = "The Number of tests to Run"
  103. Row% = BaseRow% + 5: Col% = 0: Outline% = 1: Shadow% = True: Length% = 1
  104. Message$ = SPACE$(LEN(text$))
  105. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  106. CALL LocateIt(BaseRow% + 6, text$)
  107.  
  108. text$ = SPACE$(6)
  109. COLOR 11, 0
  110. CALL LocateIt(BaseRow% + 7, text$)
  111. IsCursor (True)
  112. LOCATE BaseRow% + 7, Center%(text$)
  113.  
  114. MaxLen% = 5
  115. text$ = ""
  116. CALL TextInput(text$, MaxLen%)
  117. Samples& = VAL(text$)
  118. IF Samples& = 0 THEN END
  119.  
  120. Message$ = SPACE$(30)
  121. COLOR 11, 0
  122. Row% = BaseRow% + 11: Col% = 0: Outline% = 4: Shadow% = True: Length% = 7
  123. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  124. CALL RunRan(Samples&)
  125. CALL PressAnyKey
  126. GOTO Again
  127. END
  128.  
  129. FUNCTION Center% (text$)
  130.     Center% = 41 - LEN(text$) \ 2
  131. END FUNCTION
  132.  
  133. SUB ColorIt (Fgd, Bkg)
  134.     COLOR Fgd, Bkg
  135. END SUB
  136.  
  137. SUB DateTime (Row%, Col%, Colr%)
  138.   
  139.     CALL TwoColrs(Fgd%, Bkg%, Colr%)
  140.     COLOR Fgd%, Bkg%
  141.     StartTime! = TIMER
  142.     text$ = "Lapsed Time: " + DATE$ + " Time: " + TIME$
  143.     Message$ = SPACE$(LEN(text$) \ 2)
  144.     'TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  145.     CALL TextBoxShadow(Row%, Col%, Message$, 0, False, 1)
  146.     LOCATE Row% + 1, Col% + 1: PRINT "DATE: "; DATE$
  147.     LOCATE Row% + 2, Col% + 1: PRINT "Time: "; TIME$
  148.  
  149.  
  150. END SUB
  151.  
  152. SUB Delay (DelayTime!) STATIC
  153. 'I don't like this timer
  154. StartTime! = TIMER
  155.  
  156. Start! = TIMER
  157.  
  158. IF Start! + DelayTime! > 86400 THEN
  159.     Finish! = Start! + DelayTime! - 86400
  160.  
  161.     DO WHILE TIMER >= Start! OR TIMER <= Finish!
  162.     LOOP
  163.  
  164.     ELSE
  165.         DO WHILE TIMER <= Start! + DelayTime!
  166.         LOOP
  167. END IF
  168.  
  169. END SUB
  170.  
  171. SUB GetColr (Fgd%, Bkg%, Colr%) STATIC
  172.  
  173.     Colr% = SCREEN(1, 1, 1)
  174.  
  175.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  176.     Bkg% = (Colr% AND 112) \ 16
  177.  
  178. END SUB
  179.  
  180. SUB IsCursor (IfTrue%)
  181.     'Like this better than two SUBs of CursorOn and CursorOff
  182.     'Especially with the trouble changing the code with QuickPak
  183.     'and PDQ
  184.     IF IfTrue% = True THEN
  185.         LOCATE , , 1, 4, 7     'big cursor
  186.         'LOCATE , , 1
  187.     ELSE
  188.         LOCATE , , 0
  189.     END IF
  190. END SUB
  191.  
  192. SUB LapsedTimer (TimerRow%, TimerCol%, Colr%) STATIC
  193. STATIC Start&, LapsedTime&, StartFlag%
  194.        
  195.         IF StartFlag% = False THEN
  196.             Start& = TIMER
  197.             LapsedTime& = TIMER - Start&
  198.             StartFlag% = True
  199.         ELSE
  200.             IF TIMER >= 86400 THEN      'should trap passing midnight???
  201.                 LapsedTime& = (TIMER - Start&) - 86400
  202.             ELSE
  203.                 LapsedTime& = (TIMER - Start&)
  204.             END IF
  205.         END IF
  206.    
  207.     CALL TwoColrs(Fgd%, Bkg%, Colr%)
  208.     COLOR Fgd%, Bkg%
  209.     text$ = "Seconds" '+ STR$(LapsedTime!)
  210.    
  211.     Message$ = SPACE$((LEN(text$)) - 4)
  212.     'TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  213.     CALL TextBoxShadow(TimerRow%, TimerCol%, Message$, 0, True, 1)
  214.     LOCATE TimerRow% + 1, TimerCol% + 1: PRINT text$
  215.     LOCATE TimerRow% + 2, TimerCol% + 1: PRINT LapsedTime&
  216.  
  217. END SUB
  218.  
  219. DEFSNG A-Z
  220. SUB LocateIt (Row%, text$)
  221.      LOCATE Row%, 41 - (LEN(text$)) \ 2
  222.      PRINT text$;
  223. END SUB
  224.  
  225. DEFINT A-Z
  226. SUB OriginalTest
  227. 'from Article in NY Times Nov 24, 1994 as presented by
  228. 'Cleve Moller (sp?) from MathWorks (a software company that sell a
  229. 'big time statistical package
  230. 'to test the Pentium chip's ability.... or its lack there of rounding
  231. 'beyond -five- decimal places.
  232. 'following is based on the formula in above article.
  233. 'result? Pentium's error is larger
  234. Divisor# = 4195835
  235. Dividend# = 3145727
  236. FloatNum# = Divisor# / Dividend#
  237. Answer# = Divisor# - ((Divisor# / Dividend#) * Dividend#)
  238.  
  239. 'STOP
  240. FivePlace# = Rounded#(FloatNum#, -5)
  241. PRINT "Divided Number is: ";
  242. PRINT USING "#.###############"; FloatNum#
  243. PRINT "Rounded Number is: ";
  244. PRINT USING "#.###############"; FivePlace#
  245. PRINT "Subtract Rounded from Full number: ";
  246. PRINT USING "#.###############"; FloatNum# - FivePlace#
  247. Answer2# = Divisor# - (FivePlace# * Dividend#)
  248. PRINT "Correct Answer is: ";
  249. PRINT USING "#.###############"; Answer#
  250. PRINT "Rounded Answer is: ";
  251. PRINT USING "#.###############"; Answer2#
  252. PRINT "Pentium Chip Answer is: ";
  253. Answer3# = Divisor# - ((1.3337391#) * Dividend#)
  254. PRINT USING "###.###############"; Answer3#
  255. PRINT "=Difference= between rounded and Pentium is: ";
  256. PRINT USING "#.###############"; FloatNum# - 1.3337391#
  257.  
  258. END SUB
  259.  
  260. SUB Pause (Seconds!)
  261.  
  262.     Synch! = TIMER
  263.     DO                          'looping changes the Start! time to
  264.                 Start! = TIMER      'synchronize to the system timer
  265.     LOOP WHILE Start! = Synch!  'Seconds! must be SINGLE to get fractions
  266.                                     'of a second
  267.     DO
  268.         Kee$ = INKEY$
  269.     LOOP UNTIL TIMER > (Start! + Seconds!) OR LEN(Kee$)
  270.                           
  271.                                     'put Kee$ in just in case we pass midnight
  272.     WHILE INKEY$ <> "": WEND    'delete that key stroke
  273. END SUB
  274.  
  275. SUB PressAnyKey
  276.  
  277.     text$ = "  PRESS: A Key to Continue...  "
  278.     Row% = CSRLIN
  279.     Col% = POS(0)
  280.     Colr% = SCREEN(Row%, Col%, 1)
  281.     CALL TwoColrs(Fgd%, Bkgd%, Colr%)
  282.     COLOR 11, 0
  283.     LOCATE 24, Center(text$)
  284.     GOSUB StoreText
  285.  
  286.     PRINT text$;
  287.     COLOR Fgd%, Bkgd%
  288.     WHILE INKEY$ = "": WEND
  289.     WHILE INKEY$ <> "": WEND        'need this to remove the key press
  290.     LOCATE 24, Center(text$)
  291.     PRINT StoreScreenLine$;
  292.     'PRINT SPACE$(LEN(text$));
  293.     LOCATE Row%, Col%
  294.     EXIT SUB
  295. StoreText:
  296.  
  297.     FOR i% = 1 TO LEN(text$)
  298.         StoreScreenLine$ = StoreScreenLine$ + CHR$(SCREEN(CSRLIN, i%))
  299.     NEXT
  300.     RETURN
  301. END SUB
  302.  
  303. FUNCTION Rounded# (number#, powerOfTen%) STATIC
  304.    
  305.     'rounds using power of ten, two places for dollars
  306.     TenPower# = 10# ^ powerOfTen%
  307.     Rounded# = INT(number# / TenPower# + .5#) * TenPower#
  308.  
  309. END FUNCTION
  310.  
  311. SUB RunRan (Samples&)
  312.   
  313. Fgd% = 11
  314. Bkgd% = 0
  315. COLOR Fgd%, Bkgd%
  316. BaseRow% = CSRLIN - 9
  317. BaseCol% = 26
  318. 'STOP
  319.     RANDOMIZE TIMER
  320.     Num$ = STRING$(16, "#")
  321. '    LOCATE BaseRow% - 2, BaseCol%
  322. '    PRINT "Answer = FirstNum - ((FirstNum/SecondNum) * FirstNum)"
  323.     MakeSound& = Samples& / 100
  324.     FOR i& = 1 TO Samples&
  325.         D1# = INT(RND * 10 ^ 7)
  326.         D2# = INT(RND * 10 ^ 7)
  327.         Ans# = D1# - ((D1# / D2#) * D2#)
  328.         LOCATE BaseRow%, BaseCol%
  329.         IF NOT Ans# = 0 THEN
  330.             ErrorCount& = ErrorCount& + 1
  331.             COLOR 12, Bkgd%
  332.             PRINT "Answer: ";
  333.             PRINT USING "#." + Num$; Ans#;
  334.             COLOR 14, Bkgd%
  335.             SoundCount& = SoundCount& + 1
  336.             IF SoundCount& >= MakeSound& THEN
  337.                 SOUND 64, 1
  338.                 'PLAY "p64"
  339.                 SoundCount& = 0
  340.             END IF
  341.             Row% = BaseRow% + 2: Col% = 4: Outline% = 5: Shadow% = True: Length% = 1
  342.             Message$ = SPACE$(LEN(STR$(ErrorCount&) + "ERROR(s)") \ 2)
  343.             COLOR 15, 4
  344.             CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  345.             LOCATE BaseRow% + 3, Col% + 2
  346.             PRINT "ERROR(s)"
  347.             LOCATE BaseRow% + 4, Col% + 3
  348.             PRINT ErrorCount&
  349.         ELSE
  350.             COLOR 14, Bkgd%
  351.             PRINT "Answer: ";
  352.             PRINT USING "#." + Num$; Ans#;
  353.         END IF
  354.             COLOR Fgd%, Bkgd%
  355.             LOCATE BaseRow% + 2, BaseCol%
  356.             PRINT "Count:"; i&
  357.             LOCATE BaseRow% + 3, BaseCol%
  358.             TotD1# = TotD1# + D1#
  359.             PRINT "Sum 1st Num: ";
  360.             PRINT USING Num$ + ","; TotD1#;
  361.             LOCATE BaseRow% + 4, BaseCol%
  362.             TotD2# = TotD2# + D2#
  363.                 PRINT "Sum 2nd Num: ";
  364.             PRINT USING Num$ + ","; TotD2#;
  365.            
  366.             IF NOT Ans# = 0 THEN
  367.                 'BEEP
  368.                 LOCATE BaseRow% + 5, BaseCol%
  369.                 PRINT "Num Errors:"; ErrorCount&
  370.                 SumAns# = SumAns# + Ans#
  371.                 LOCATE BaseRow% + 6, BaseCol%
  372.                 PRINT "Sum Errors: ";
  373.                 PRINT USING "#." + Num$; SumAns#;
  374.                 'SUB LapsedTimer (Row%, Col%, Colr%)
  375.                 'need to change so it senses restarting timer
  376.                 IF ErrorCount& = 1 THEN
  377.                     ReStart% = True
  378.                 END IF
  379.                 CALL LapsedTimer(12, 61, 59)
  380.  
  381.             END IF
  382.  
  383.             IF ErrorCount& > 200 THEN
  384.           
  385.             Row% = BaseRow% + 9: Col% = 0: Outline% = 0: Shadow% = False: Length% = False
  386.             Message$ = "{Ctrl}+{BREAK} to ABORT"
  387.             COLOR 14, 2
  388.             CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  389.           
  390.             END IF
  391.     NEXT
  392.     'STOP
  393. END SUB
  394.  
  395. SUB Splash1
  396. Q$ = CHR$(34)
  397. COLOR 11, 1:
  398. PRINT
  399. PRINT "       ███████┐ ███████┐ ██████┐ ██┐ ████████┐ ████┐ ██┐  ██┐ ██████████┐       ";
  400. PRINT "       ██┌──██│ ██┌────┘ ██┌─██│ ██│ └──██┌──┘ └██┌┘ ██│  ██│ ██┌─██┌─██│       ";
  401. PRINT "       ███████│ █████┐   ██│ ██│ ██│    ██│     ██│  ██│  ██│ ██│ ██│ ██│       ";
  402. PRINT "       ██┌────┘ ██┌──┘   ██│ ██│ ██│    ██│     ██│  ██│  ██│ ██│ ██│ ██│       ";
  403. PRINT "       ██│      ███████┐ ██│ ██████│    ██│    ████┐ ███████│ ██│ ██│ ██│       ";
  404. PRINT "       └─┘      └──────┘ └─┘ └─────┘    └─┘    └───┘ └──────┘ └─┘ └─┘ └─┘       ";
  405. COLOR 15, 1:
  406. PRINT "        Much ado about the discovery that the INTEL Pentium chip.... like       ";
  407. PRINT "        all CPUs... makes long division math errors. The Internet community     ";
  408. PRINT "        is up in arms. The formula (in: NY Times 11/24/1994) which gives a      ";
  409. PRINT "        PENTIUM chip error with two (2) =particular= numbers is:                ";
  410. PRINT "                                                                                ";
  411. PRINT "              Answer = 4,195,835 -[(4,195,835 / 3,145,727) * 3,145,727]         ";
  412. COLOR 14, 1:
  413. PRINT "                     (FirstNumber)            (SecondNumber)                    ";
  414. COLOR 15, 1:
  415. PRINT "";
  416. PRINT "        The Answer is Zero (0) because you divide -then- multiply one           ";
  417. PRINT "        number by a second number. With a Pentium chip, the answer with         ";
  418. PRINT "        -these numbers- is "; 256; " or an error of 256/4,195,835 or            ";
  419. PRINT "        61/100,000. This program generates from one to millions of RANDOM       ";
  420. PRINT "        numbers using the same, simple formula to show you that your very       ";
  421. PRINT "        own beloved computer will do just what the INTEL Pentium chip           ";
  422. PRINT "        does.... give you long division errors.";
  423. PRINT "                                                                                ";
  424. COLOR 14, 1: PRINT "                      John De Palma on CompuServe 76076,571                     ";
  425. COLOR 15, 1: PRINT "                                                                                ";
  426. COLOR 7, 0
  427.  
  428. END SUB
  429.  
  430. SUB Splash2 (Choice%)
  431. 'prints a full screen of: ⌠⌠⌠⌠⌠⌠⌠⌠
  432. '                         ⌡⌡⌡⌡⌡⌡⌡⌡
  433.  
  434. SELECT CASE Choice%
  435.     CASE 1
  436.         Char1% = 244
  437.         Char2% = 245
  438.     CASE 2
  439.         Char1% = 174
  440.         Char2% = 175
  441.     CASE 3
  442.         Char1% = 242
  443.         Char2% = 243
  444.     CASE 4
  445.         Char1% = 47
  446.         Char2% = 92
  447.     CASE 5
  448.         Char1% = 220
  449.         Char2% = 240
  450.     CASE 6
  451.         Char1% = 221
  452.         Char2% = 222
  453.     CASE 7
  454.         Char1% = 180
  455.         Char2% = 195
  456.     CASE 8
  457.         Char1% = 254
  458.         Char2% = 222
  459.     CASE 9
  460.         Char1% = 146
  461.         Char2% = 158
  462.     CASE 10
  463.         Char1% = 159
  464.         Char2% = 159
  465.     CASE ELSE
  466.         Char1% = 244
  467.         Char2% = 245
  468. END SELECT
  469.  
  470.     FOR i = 1 TO 25 STEP 2
  471.         LOCATE i, 1
  472.         PRINT STRING$(80, Char1%);
  473.     NEXT
  474.     FOR i = 2 TO 24 STEP 2
  475.         LOCATE i, 1
  476.         PRINT STRING$(80, Char2%);
  477.     NEXT
  478.  
  479. END SUB
  480.  
  481. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  482.   
  483.     'Adding other ancillary SUBs as "GOSUB"s so that they
  484.     'do not need to be imported into a new module.
  485.     'edited to omit the SUB TwoColr(Fgd%,Bkg,Colr%)
  486.     'and tested Sun  08-21-1994  21:25:34
  487.  
  488.     'got to have a REDIM SHARED Box$(1 to 56) in main module
  489.     'Other SUB/FUNCTIONs still needed for this SUB are:
  490.     'SUB
  491.     'LocateIt(Row%, Text$)
  492.     'FUNCTION
  493.     'Center% (text$)
  494.     '
  495.     'Puts a message into a three line box -or-
  496.     'draw a box without a message using Message$=SPACE$(x)
  497.     'where "x" is the width of the box and Length%= number of lines > 3
  498.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  499.     'Boxes display a true shadow if Shadow% <> 0
  500.     'True = -1: False = 0
  501.  
  502.     STATIC BoxReadFlag
  503.     Message$ = LEFT$(Message$, 60)
  504.     BoxWidth% = LEN(Message$) + 4
  505.     SELECT CASE Outline%
  506.         CASE 0
  507.             j = 8 * 6 + 1
  508.         CASE 1
  509.             j = 1
  510.         CASE 2
  511.             j = 8 + 1
  512.         CASE 3
  513.             j = 8 * 2 + 1
  514.         CASE 4
  515.             j = 8 * 3 + 1
  516.         CASE 5
  517.             j = 8 * 4 + 1
  518.         CASE 6
  519.             j = 8 * 5 + 1
  520.         CASE ELSE
  521.             j = 8 * 6 + 1
  522.     END SELECT
  523.  
  524.     IF BoxReadFlag THEN GOTO Skip
  525.     REDIM Box$(1 TO 56)
  526.     BoxReadFlag = True
  527.  
  528. 'single line box
  529.     Box$(1) = "┌"
  530.     Box$(2) = "─"
  531.     Box$(3) = "┐"
  532.     Box$(4) = "│"
  533.     Box$(5) = "│"
  534.     Box$(6) = "└"
  535.     Box$(7) = "─"
  536.     Box$(8) = "┘"
  537.  
  538. 'double top box
  539.     Box$(9) = "╒"
  540.     Box$(10) = "═"
  541.     Box$(11) = "╕"
  542.     Box$(12) = "│"
  543.     Box$(13) = "│"
  544.     Box$(14) = "╘"
  545.     Box$(15) = "═"
  546.     Box$(16) = "╛"
  547.  
  548. 'double side box
  549.     Box$(17) = "╓"
  550.     Box$(18) = "─"
  551.     Box$(19) = "╖"
  552.     Box$(20) = "║"
  553.     Box$(21) = "║"
  554.     Box$(22) = "╙"
  555.     Box$(23) = "─"
  556.     Box$(24) = "╜"
  557.  
  558. 'double box
  559.     Box$(25) = "╔"
  560.     Box$(26) = "═"
  561.     Box$(27) = "╗"
  562.     Box$(28) = "║"
  563.     Box$(29) = "║"
  564.     Box$(30) = "╚"
  565.     Box$(31) = "═"
  566.     Box$(32) = "╝"
  567.  
  568. 'bold box
  569.     Box$(33) = "█"
  570.     Box$(34) = "▀"
  571.     Box$(35) = "█"
  572.     Box$(36) = "█"
  573.     Box$(37) = "█"
  574.     Box$(38) = "█"
  575.     Box$(39) = "▄"
  576.     Box$(40) = "█"
  577.  
  578. 'bold and thick box
  579.     Box$(41) = "█"
  580.     Box$(42) = "█"
  581.     Box$(43) = "█"
  582.     Box$(44) = "█"
  583.     Box$(45) = "█"
  584.     Box$(46) = "█"
  585.     Box$(47) = "█"
  586.     Box$(48) = "█"
  587.  
  588. 'no box
  589.     Box$(49) = " "
  590.     Box$(50) = " "
  591.     Box$(51) = " "
  592.     Box$(52) = " "
  593.     Box$(53) = " "
  594.     Box$(54) = " "
  595.     Box$(55) = " "
  596.     Box$(56) = " "
  597.  
  598. Skip:
  599.  
  600.    
  601.   
  602.     IF Col% = 0 THEN
  603.  
  604.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  605.             GOSUB Location
  606.             'CALL LocateIt(Row%, BoxText$)
  607.             Row2% = CSRLIN: Col2% = POS(0)
  608.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  609.             'GOSUB GetTwoColors
  610.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  611.    
  612.             FOR i = 1 TO Length% + 1
  613.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  614.             'GOSUB Location
  615.             CALL LocateIt(Row% + i, BoxText$)
  616.  
  617.             IF Shadow% THEN
  618.                 COLOR 7, 0
  619.                     FOR k = 1 TO 2
  620.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  621.                     NEXT
  622.                 COLOR Fgd%, Bkg%
  623.             END IF
  624.             NEXT i
  625.  
  626.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  627.             'GOSUB Location
  628.             CALL LocateIt(Row% + i, BoxText$)
  629.      
  630.             IF Shadow% THEN
  631.                 COLOR 7, 0
  632.                 FOR k = 1 TO 2
  633.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  634.                 NEXT
  635.             'COLOR Fgd%, Bkg%
  636.    
  637.             COLOR 7, 0
  638.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  639.      
  640.                 FOR k = 1 TO BoxWidth% + 2
  641.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  642.                 NEXT
  643.                 COLOR Fgd%, Bkg%
  644.             END IF
  645.     ELSE
  646.  
  647.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  648.             LOCATE Row%, Col%
  649.             PRINT BoxText$;
  650.             Row2% = CSRLIN: Col2% = POS(0)
  651.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  652.             GOSUB GetTwoColors
  653.                         'CALL TwoColrs(Fgd%, Bkg%, Colr%)
  654.  
  655.             FOR i = 1 TO Length% + 1
  656.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  657.             LOCATE Row% + i, Col%
  658.             PRINT BoxText$;
  659.      
  660.             IF Shadow% THEN
  661.                 COLOR 7, 0
  662.                 FOR k = 1 TO 2
  663.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  664.                 NEXT
  665.                 COLOR Fgd%, Bkg%
  666.             END IF
  667.      
  668.             NEXT i
  669.  
  670.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  671.             LOCATE Row% + i, Col%
  672.             PRINT BoxText$;
  673.      
  674.             IF Shadow% THEN
  675.                 COLOR 7, 0
  676.                 FOR k = 1 TO 2
  677.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  678.                 NEXT
  679.               
  680.                 LOCATE Row% + i + 1, Col% + 2
  681.                 FOR k = 1 TO BoxWidth% + 2
  682.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  683.                 NEXT
  684.                 COLOR Fgd%, Bkg%
  685.             END IF
  686.  
  687.     END IF
  688.     EXIT SUB
  689. GetTwoColors:
  690.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  691.     Bkg% = (Colr% AND 112) \ 16
  692. RETURN
  693.  
  694. Location:
  695.     LOCATE Row%, 41 - (LEN(BoxText$)) \ 2
  696.     PRINT BoxText$;
  697. RETURN
  698.  
  699. END SUB
  700.  
  701. SUB TextInput (text$, MaxLen%) STATIC
  702.  
  703. 'Set up cursor, line, and maximum characters to enter:
  704.  
  705. y% = CSRLIN
  706. LOCATE , , 1
  707. IF MaxLen% > (79 - POS(0)) THEN MaxLen% = (79 - POS(0))
  708. 'STOP
  709. 'Display default text:
  710. COLOR 11, 0
  711. 'Row% = CSRLIN
  712. 'Col% = POS(0)
  713. 'PRINT text$;
  714. 'LOCATE Row%, Col%
  715. DO
  716.     i$ = INKEY$
  717.    
  718.     SELECT CASE LEFT$(i$, 1)
  719.         CASE CHR$(8)                      'Backspace
  720.             'STOP
  721.             IF text$ > "" THEN
  722.                 text$ = LEFT$(text$, LEN(text$) - 1)
  723.                 LOCATE y%, POS(0) - 1
  724.                 PRINT " ";
  725.                 LOCATE , POS(0) - 1
  726.             END IF
  727.  
  728.         CASE CHR$(32) TO CHR$(255)        'Valid characters
  729.             'STOP
  730.             IF LEN(text$) <= MaxLen% THEN
  731.                 PRINT LEFT$(i$, 1);
  732.                 text$ = text$ + LEFT$(i$, 1)
  733.             ELSE
  734.                 BEEP
  735.             END IF
  736.  
  737.         CASE "", CHR$(13)                   'Null or carriage return
  738.  
  739.         CASE ELSE                           'Non-printables, etc.
  740.             BEEP
  741.     END SELECT
  742.  
  743. LOOP UNTIL i$ = CHR$(13)
  744. LOCATE , , 0
  745. PRINT
  746. END SUB
  747.  
  748. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  749.  
  750.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  751.     Bkg% = (Colr% AND 112) \ 16
  752.  
  753. END SUB
  754.  
  755. FUNCTION YesNo2% (Answer$) STATIC
  756.     'STOP
  757.   
  758.     WHILE INKEY$ <> "": WEND
  759.   
  760.     DO
  761.         YN$ = INKEY$
  762.     LOOP UNTIL LEN(YN$)
  763.     IF YN$ = CHR$(27) THEN END
  764.  
  765.     YesNo2% = INSTR(Answer$, YN$)           'Answer$ is the search string
  766.  
  767.     'COMMANDS TO CALL THIS FUNCTION:
  768.     'Answer$ = "yY" + CHR$(13) + "nN"       'neat to use {Enter}
  769.     'IF YesNo2% > 0 AND YesNo2% < 4 THEN GOTO Again
  770.         'IF YesNo2% <= 0 OR YesNo2% > 3 THEN PRINT "E"
  771.         'can use a function key as:
  772.         'F1$ = CHR$(0)+";"
  773.  
  774. END FUNCTION
  775.  
  776.